home *** CD-ROM | disk | FTP | other *** search
/ Aminet 44 / Aminet 44 (2001)(GTI - Schatztruhe)[!][Aug 2001].iso / Aminet / misc / emu / p-interp.lha / p-interp-0.4 / interpreter.c < prev    next >
C/C++ Source or Header  |  2001-06-11  |  51KB  |  2,357 lines
  1. /*
  2.  
  3.   P-Code interpreter (to run the apple pascal system)
  4.   Copyright (C) 2000 Mario Klebsch
  5.  
  6.   This program is free software; you can redistribute it and/or modify
  7.   it under the terms of the GNU General Public License as published by
  8.   the Free Software Foundation; either version 2 of the License, or
  9.   (at your option) any later version.
  10.  
  11.   This program is distributed in the hope that it will be useful,
  12.   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.   GNU General Public License for more details.
  15.  
  16.   You should have received a copy of the GNU General Public License
  17.   along with this program; if not, write to the Free Software
  18.   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19.  
  20.  
  21.   $Log: interpreter.c,v $
  22.   Revision 1.13  2001/06/07 18:54:40  mario
  23.   Abschneiden von zu grossen Werten beim STP(Store Packed)-Befehl. Ein
  24.   Bug? im eXamine-Kommando des Filers macht diese Änderung notwendig.
  25.  
  26.   Revision 1.12  2001/06/06 23:00:27  mario
  27.   Anzahl der Elemente beim Compare von Byte- und Word-Arrays
  28.   ist B, nicht UB.
  29.  
  30.   Revision 1.11  2001/05/29 22:52:31  mario
  31.   Quellenangabe für das Programm hinzugefügt
  32.  
  33.   Revision 1.10  2001/05/27 19:02:04  mario
  34.   Opcodes in List() durch Mnemonics ersetzt.
  35.  
  36.   Revision 1.9  2001/05/27 18:59:54  mario
  37.   Code zur Berechnung der Fehlerstelle in XeqError an die verschiedenen
  38.   Konfigurationsmöglichkeiten angepasst.
  39.  
  40.   Revision 1.8  2001/05/27 16:31:46  mario
  41.   Debugger wieder eingebaut.
  42.  
  43.   Revision 1.7  2001/05/27 16:21:48  mario
  44.   - Neue Kommandozeilenoption zum Tracen einer einzigen Prozedur
  45.  
  46.   - Auch beim Disassemblieren  von Segment 0 werden jetzt die
  47.     korrekten Prozedurnamen angezeigt.
  48.  
  49.   Revision 1.6  2001/05/27 16:16:23  mario
  50.   Fehlerbehandlung patcht jetzt MISCINFO
  51.  
  52.   Revision 1.5  2001/05/26 16:51:35  mario
  53.   Diverse Kommentare eingefügt, einige Funktionen umgruppiert.
  54.  
  55.   Revision 1.4  2001/05/26 15:13:29  mario
  56.   Diverse kleine Fehler behoben, fehlende #includes, Labels ohne Statement
  57.   dahinter, ...
  58.  
  59.   Revision 1.3  2001/05/21 20:50:55  mario
  60.   Trace nach stdout implementiert
  61.  
  62.   Revision 1.2  2001/05/20 13:12:02  mario
  63.   CVS-Idents und Logs eingefügt
  64.  
  65.  
  66. */
  67.  
  68. #ident "$Id: interpreter.c,v 1.13 2001/06/07 18:54:40 mario Exp $";
  69.  
  70. #include <assert.h>
  71. #include <stdio.h>
  72. #include <unistd.h>
  73. #include <stdlib.h>
  74. #include <ctype.h>
  75. #include <stdarg.h>
  76. #include <string.h>
  77. #include <setjmp.h>
  78. #include <math.h>
  79. #include <sys/types.h>
  80. #include <sys/stat.h>
  81. #include <sys/time.h>
  82. #include <fcntl.h>
  83.  
  84. #include "version.h"
  85. #include "psystem.h"
  86. #include "Memory.h"
  87. #include "Stack.h"
  88. #include "Sets.h"
  89. #include "Array.h"
  90. #include "Diskio.h"
  91. #include "Term.h"
  92.  
  93. #include "pcode.h"
  94.  
  95. #undef IXP_COMPATIBILITY
  96. #undef TRACE_TRANSLATE
  97. #define TIME_SCALE    1
  98.  
  99. word DisasmP    (char *Buffer,
  100.          word SegNo,
  101.          word IpcBase,
  102.          word Ipc,
  103.          word JTab,
  104.          word Sp);
  105.  
  106. static FILE    *TraceFile=NULL;
  107. static byte    TraceSeg;
  108. static byte    TraceProc;
  109.  
  110. #define APPLE_HEAP_BOT        0x0804
  111. #define APPLE_KP_TOP        0xfe7c
  112. #define APPLE_SEG0_LOAD_GAP    0x450a
  113. #define APPLE_SYSCOM        0xbdde
  114.  
  115. #ifdef TRACE_TRANSLATE
  116. #define KP_TOP            0xe000
  117. #define HEAP_BOT        0x1000
  118. #else
  119. #define KP_TOP            0xfe80
  120. #define HEAP_BOT        0x0200
  121. #endif
  122.  
  123. #define NUMBER(a)    (sizeof(a)/sizeof(a[0]))
  124.  
  125. typedef struct SegDict
  126. {
  127.   int        UseCount;
  128.   word        OldKp;
  129.   word        Seg;
  130.   word        SegBase;
  131. } SegDict_t;
  132.  
  133. SegDict_t    SegDict[32];
  134.  
  135. #define MS_KP        -1
  136. #define MS_STAT        0
  137. #define MS_DYN        1
  138. #define MS_JTAB        2
  139. #define MS_SEG        3
  140. #define MS_IPC        4
  141. #define    MS_SP        5
  142. #define MS_VAR        5        /* Var-Offset counts from 1.. */
  143. #define MS_FRAME_SIZE    6
  144.  
  145. /* Official P-Machine registers */
  146. word    Sp;
  147. word    Ipc;
  148. word    IpcBase;
  149. word    Seg;
  150. word    JTab;
  151. word    Kp;
  152. word    Mp;
  153. word    Np;
  154. word    Base;
  155.  
  156. word    Syscom;
  157.  
  158. /* Flags */
  159.  
  160. #ifndef WORD_MEMORY
  161. int    AppleCompatibility=0;
  162. #endif
  163.  
  164. /* Additional Bookkeeping */
  165. static word CurrentIpc;
  166. static word BaseMp;
  167. unsigned int    Level=0;
  168. unsigned int    TraceLevel=0;
  169. jmp_buf        ProcessNextInstrunction;
  170.  
  171. #ifdef XXX
  172.  
  173. /* Zwei Funktionen, die früher einmal in Debug-Ausgaben benötigt
  174.    wurden, nun aber nicht mehr aufgerufen werden. Sie sind aber zu
  175.    schade, um schon in /dev/null entsorgt zu werden. */
  176.  
  177. char *PStr(word w)
  178. {
  179.   static char    Buffer[256];
  180.   int        len=MemRdByte(w,0);
  181.   char        *p=Buffer;
  182.   int        i;
  183.  
  184.   for (i=0; i<len; i++)
  185.     *p++=MemRdByte(w, i+1);
  186.   *p++='\0';
  187.   return(Buffer);
  188. }
  189.  
  190. char *MultipleWords(word Addr, word Len)
  191. {
  192.   static char    Buffer[5*256+1];
  193.   char        *p=Buffer;
  194.   while (Len--)
  195.     {
  196.       sprintf(p,",%04x", MemRd(Addr));
  197.       p+=strlen(p);
  198.       Addr=WordIndexed(Addr, 1);
  199.     }
  200.   return(Buffer);
  201. }
  202.  
  203. void CheckCallStack(void)
  204. {
  205.   int i;
  206.   word    p=Mp;
  207.  
  208.   for (i=0;i<Level;i++)
  209.     {
  210.       assert(p);
  211.       p=MemRd(WordIndexed(p, MS_DYN));
  212.     }
  213.   assert(p==(0xb000-4));
  214. }
  215. #endif
  216.  
  217. void warning(char *Msg, ...)
  218. {
  219.   va_list ap;
  220.   char    Buffer[512];
  221.   va_start(ap, Msg);
  222.   vsnprintf(Buffer, sizeof(Buffer), Msg, ap);
  223.   va_end(ap);
  224.   fprintf(stderr,"warning: %s\n", Buffer);
  225.   /*  TraceLevel=0x7fff;*/
  226. }
  227.  
  228. void DumpCore(void)
  229. {
  230.   FILE        *f;
  231.   if ((f=fopen("ucsd.core","w")))
  232.     {
  233.       MemDump(f,0,0xffff);
  234.       fclose(f);
  235.     }
  236.   else
  237.     warning("DumpCore: unable to create core dump");
  238. }
  239.  
  240. void panic(char *Msg, ...)
  241. {
  242.   va_list    ap;
  243.   char        Buffer[512];
  244.  
  245.   TermClose();
  246.   va_start(ap, Msg);
  247.   vsnprintf(Buffer, sizeof(Buffer), Msg, ap);
  248.   va_end(ap);
  249.   fprintf(stderr,"panic: %s\n", Buffer);
  250.   DumpCore();
  251.   abort();
  252. }
  253.  
  254. /* Convert to boolean. */
  255. inline word Boolean(word i)
  256. {
  257.   return(i?1:0);
  258. }
  259.  
  260. void MoveLeft(word Dst, Integer DstOffset,
  261.           word Src, Integer SrcOffset, word Len)
  262. {
  263.   while (Len--)
  264.     MemWrByte(Dst, DstOffset++,MemRdByte(Src, SrcOffset++));
  265. }
  266.  
  267. void MoveRight(word Dst, Integer DstOffset,
  268.            word Src, Integer SrcOffset, word Len)
  269. {
  270.   SrcOffset+=Len;
  271.   DstOffset+=Len;
  272.   while (Len--)
  273.     MemWrByte(Dst, --DstOffset, MemRdByte(Src,--SrcOffset));
  274. }
  275.  
  276. word FetchB(void)
  277. {
  278.   byte b;
  279.   b = MemRdByte(IpcBase, Ipc++);
  280.   if (b&0x80)
  281.     return ( (word)((b&0x7f)<<8) + (word)MemRdByte(IpcBase, Ipc++) );
  282.   else
  283.     return ( (word)b );
  284. }
  285.  
  286. inline word FetchW(void)
  287. {
  288.   word    w;
  289.   w =  MemRdByte(IpcBase, Ipc++);
  290.   w += (MemRdByte(IpcBase, Ipc++)<<8);
  291.   return(w);
  292. }
  293.  
  294. inline word FetchUB(void)
  295. {
  296.   return ( (word)MemRdByte(IpcBase, Ipc++) );
  297. }
  298.  
  299. /* Dereference a self relocating pointer. Self relocating pointers are
  300.    used in the segment dictionary and in procedure activation records. */
  301. static inline word SelfRelPtr(word Addr)
  302. {
  303. #ifdef WORD_MEMORY
  304.   return(Addr-MemRd(Addr)/2);
  305. #else
  306.   return(Addr-MemRd(Addr));
  307. #endif
  308. }
  309.  
  310. /* Returns the number of procedures of a segment */
  311. inline byte SegNumProc(word Seg)
  312. {
  313.   return(MemRd(Seg)>>8);
  314. }
  315.  
  316. /* Return the segment number of a segment */
  317. inline byte SegNumber(word Seg)
  318. {
  319.   return(MemRd(Seg)&0xff);
  320. }
  321.  
  322. /* Returns a pointer to the activation record of a specified procedure
  323.    in a specified segment */
  324. inline word Proc(word Seg, byte ProcNr)
  325. {
  326.   PointerCheck(Seg);
  327.   if ((ProcNr<1) || (ProcNr>SegNumProc(Seg)) )
  328.     panic("Proc: Illegal Procedure Number %d",ProcNr);
  329.   return(SelfRelPtr(WordIndexed(Seg,-ProcNr)));
  330. }
  331.  
  332. /* Returns the procedure number of a procedure */
  333. inline signed char ProcNumber(word JTab)
  334. {
  335.   PointerCheck(JTab);
  336.   return (MemRd(JTab)&0xff);
  337. }
  338.  
  339. /* Returns the lex level of a procedure */
  340. inline signed char ProcLexLevel(word JTab)
  341. {
  342.   PointerCheck(JTab);
  343.   return (MemRd(JTab)>>8);
  344. }
  345.  
  346. /* Returns a pointer to the first instruction of a procedure */
  347. static inline word ProcBase(word JTab)
  348. {
  349.   PointerCheck(JTab);
  350.   return (SelfRelPtr(WordIndexed(JTab,-1)));
  351. }
  352.  
  353. /* Returns the byte offset to the exit code of a procedure. */
  354. inline word ProcExitIpc(word JTab)
  355. {
  356.   PointerCheck(JTab);
  357.   return (MemRd(WordIndexed(JTab,-1))-
  358.       MemRd(WordIndexed(JTab,-2))-2);
  359. }
  360.  
  361. /* Returns the size of the parameters, which are passed to a
  362.    procedure. */
  363. inline word ProcParamSize(word JTab)
  364. {
  365.   PointerCheck(JTab);
  366.   return (MemRd(WordIndexed(JTab,-3)));
  367. }
  368.  
  369. /* Returns the size of the storage a procedure needs for its local
  370.    variables. */
  371. inline word ProcDataSize(word JTab)
  372. {
  373.   PointerCheck(JTab);
  374.   return (MemRd(WordIndexed(JTab,-4)));
  375. }
  376.  
  377. /* Returns a pointer to a local variable. */
  378. inline word LocalAddr(word Offset)
  379. {
  380.   return(WordIndexed(Mp, MS_VAR+Offset));
  381. }
  382.  
  383. /* Returns a pointer to a global variable. */
  384. inline word GlobalAddr(word Offset)
  385. {
  386.   return(WordIndexed(Base,MS_VAR+Offset));
  387. }
  388.  
  389. /* Traverse the static link chain. */
  390. inline word Intermediate(byte Count)
  391. {
  392.   word p;
  393.   for (p=Mp;Count;Count--)
  394.     p=MemRd(WordIndexed(p,MS_STAT));
  395.   return(p);
  396. }
  397.  
  398. /* Returns a pointer to a variable of an enclosing procedure. */
  399. inline word IntermediateAddr(word Offset, byte Count)
  400. {
  401.   return( WordIndexed(Intermediate(Count), MS_VAR+Offset) );
  402. }
  403.  
  404. /* Returns a pointer to a variable in a data segment (a global
  405.    variable in a UNIT) */
  406. inline word ExtendedAddr(word Offset, byte SegNo)
  407. {
  408.   assert(SegNo<NUMBER(SegDict));
  409.   return(WordIndexed(SegDict[SegNo].Seg, Offset));
  410. }
  411.  
  412. /* calculates the target address of a jump operation. Positive
  413.    displacements perform relative jumps, negative displacements are
  414.    used as indices into the jump table. */
  415. word jump(signed char disp)
  416. {
  417.   if (disp >=0)
  418.     return(Ipc+disp);
  419.   disp=-disp;
  420. #ifdef WORD_MEMORY
  421.   return(MemRd(WordIndexed(JTab, -1))+2-
  422.      (MemRd(JTab-disp/2)+disp));
  423. #else
  424.   return(MemRd(WordIndexed(JTab, -1))+2-
  425.      (MemRd(JTab-disp)+disp));
  426. #endif
  427. }
  428.  
  429. /* Calculates the static link pointer for a procedure */
  430. inline word StaticLink(word NewSeg, byte ProcNo)
  431. {
  432.   word NewJTab=Proc(NewSeg, ProcNo);
  433.  
  434.   if (!ProcNumber(NewJTab))
  435.     return(NIL);
  436.   return(Intermediate(ProcLexLevel(JTab)-
  437.               ProcLexLevel(NewJTab)+1));
  438. }
  439.  
  440. /* load a segment. If a data segment is to be loaded, just allocate
  441.    storage on the stack */
  442. void CspLoadSegment(byte SegNo)
  443. {
  444.   assert (SegNo<NUMBER(SegDict));
  445.   if (!SegDict[SegNo].UseCount)
  446.     {
  447.       word SegUnit  = MemRd(SEG_UNIT(SegNo));
  448.       word SegBlock = MemRd(SEG_BLOCK(SegNo));
  449.       word SegSize  = MemRd(SEG_SIZE(SegNo));
  450.  
  451.       assert (!(SegSize&1));
  452.       if (!SegSize)
  453.     XeqError(XNOPROC);
  454.  
  455.       SegDict[SegNo].OldKp=Kp;
  456. #ifdef WORD_MEMORY
  457.       Kp-=SegSize/2;
  458. #else
  459.       Kp-=SegSize;
  460. #endif
  461.       SegDict[SegNo].SegBase=Kp;
  462.       if (SegBlock)            /* if a block number is specified,  */
  463.     {                /* load a code segment.            */
  464.       SegDict[SegNo].Seg=WordIndexed(SegDict[SegNo].OldKp,-1);
  465.       DiskRead(SegUnit, Kp, 0, SegSize, SegBlock);
  466.       if (MemRd(IORSLT))
  467.         XeqError(XSYIOER);
  468.     }
  469.       else                /* it is a Data-Segment            */
  470.     SegDict[SegNo].Seg=WordIndexed(Kp,-1);
  471.     }
  472.   SegDict[SegNo].UseCount++;
  473. }
  474.  
  475. void CspUnloadSegment(byte SegNo)
  476. {
  477.   SegDict[SegNo].UseCount--;
  478.   if (!SegDict[SegNo].UseCount)
  479.     {
  480.       Kp=SegDict[SegNo].OldKp;
  481.       SegDict[SegNo].OldKp = 0;
  482.       SegDict[SegNo].Seg   = 0;
  483.     }
  484. }
  485.  
  486. /* Clear the global directory pointer. */
  487. void ClrGDirP(void)
  488. {
  489.   word GDirP=MemRd(GDIRP);
  490.   if (GDirP!=NIL)
  491.     {
  492.       Np=GDirP;
  493.       MemWr(GDIRP, NIL);
  494.     }
  495. }
  496.  
  497. /* check for a gap between heap and stack */
  498. void StackCheck(void)
  499. {
  500.   if (Np>=Kp)
  501.     {
  502.       MemWr(GDIRP, NIL);
  503.       Kp=0x8000;
  504.       Np=0x6200;
  505.       XeqError(XSTKOVR);
  506.     }
  507. }
  508.  
  509. /* call a procedure. It does build a stack frame for the new procedure
  510.    and sets up all recisters of the p-machine. */
  511. int call(word NewSeg, byte ProcNr, word StaticLink)
  512. {
  513.   word    NewJTab      = Proc(NewSeg, ProcNr);
  514.   word    DataSize  = ProcDataSize(NewJTab);
  515.   word    ParamSize = ProcParamSize(NewJTab);
  516.   word    NewMp      = WordIndexed(Kp, -(DataSize + ParamSize)/2);
  517.  
  518.   if (!ProcNumber(NewJTab))
  519.     {
  520.       ProcessNative(NewJTab);
  521.       return(1);
  522.     }
  523.  
  524.   assert(!(ParamSize&1));
  525.  
  526.   MoveLeft(NewMp, 0, Sp, 0, ParamSize);
  527.   Sp=WordIndexed(Sp,ParamSize/2);
  528.  
  529.   NewMp = WordIndexed(NewMp, -MS_FRAME_SIZE);
  530.   if (ProcLexLevel(NewJTab) <= 0)
  531.     {
  532.       Push(Base);
  533.       Base=NewMp;
  534.       MemWr(STKBASE,Base);
  535.     }
  536.  
  537.   MemWr(WordIndexed(NewMp,MS_KP),   Kp);
  538.   MemWr(WordIndexed(NewMp,MS_STAT), StaticLink);
  539.   MemWr(WordIndexed(NewMp,MS_DYN),  Mp);
  540.   MemWr(WordIndexed(NewMp,MS_JTAB), JTab);
  541.   MemWr(WordIndexed(NewMp,MS_SEG),  Seg);
  542.   MemWr(WordIndexed(NewMp,MS_IPC),  Ipc);
  543.   MemWr(WordIndexed(NewMp,MS_SP),   Sp);
  544.  
  545.   Kp      = WordIndexed(NewMp, -1);    /* Kleiner Hack :-( */
  546.   Mp      = NewMp;
  547.   Seg     = NewSeg;
  548.   JTab    = NewJTab;
  549.   MemWr(LASTMP, Mp);
  550. #ifdef SEG
  551.   MemWr(SEG,    Seg);
  552. #endif
  553. #ifdef JTAB
  554.   MemWr(JTAB,   JTab);
  555. #endif
  556.  
  557.   IpcBase = ProcBase(JTab);
  558.   Ipc     = 0;
  559.   Level++;
  560.   StackCheck();
  561.   return(0);
  562. }
  563.  
  564. void ret(byte n)
  565. {
  566.   word    OldMp=Mp;
  567.   byte    OldSegNo=SegNumber(Seg);
  568.  
  569.   while (n>0)
  570.     Push(MemRd(LocalAddr(n--)));
  571.  
  572.   Kp      = MemRd(WordIndexed(OldMp,MS_KP));
  573.   Mp      = MemRd(WordIndexed(OldMp,MS_DYN));
  574.   JTab    = MemRd(WordIndexed(OldMp,MS_JTAB));
  575.   IpcBase = ProcBase(JTab);
  576.   Seg     = MemRd(WordIndexed(OldMp,MS_SEG));
  577.   Ipc     = MemRd(WordIndexed(OldMp,MS_IPC));
  578.   MemWr(LASTMP, Mp);
  579. #ifdef SEG
  580.   MemWr(SEG,    Seg);
  581. #endif
  582. #ifdef JTAB
  583.   MemWr(JTAB,   JTab);
  584. #endif
  585.  
  586.   if (OldSegNo != SegNumber(Seg))
  587.     if (OldSegNo)            /* Segment 0 wird nicht verwaltet   */
  588.       CspUnloadSegment(OldSegNo);
  589.   Level--;
  590.   StackCheck();
  591. }
  592.  
  593. /* An execution error has occured. Resum executon at segment 2
  594.    procedure 1, the system error handler */
  595. void XeqError(word err)
  596. {
  597.   static int Flag=0;
  598.   word    NewSeg=SegDict[0].Seg;
  599.  
  600.   if (Flag)
  601.     panic("XeqError: recursion");
  602.   Flag++;
  603.  
  604.   MemWr(XEQERR,  err);
  605. #ifdef BOMBPROC
  606.   MemWr(BOMBPROC,  ProcNumber(JTab));
  607. #endif
  608. #ifdef BOMBSEG
  609.   MemWr(BOMBSEG,  SegNumber(Seg));
  610. #endif
  611.  
  612. #if 0
  613. #ifndef WORD_MEMORY
  614.   /* The bytewise interpreter used in Apple Pascal did use Pointers
  615.      for the Ipc. Addinf the Offset to IpcBase id sufficient to
  616.      emulate this behavoir. */
  617.   MemWr(BOMBIPC, IpcBase+CurrentIpc);
  618. #else
  619.   /* In my wordwise interpreter, I do calculate this value in a way,
  620.      that the Apple Pascal error printing routine does print the
  621.      correct result. But, this value for BOMBIPC is not the location
  622.      of the failed instruction. */
  623.   MemWr(BOMBIPC,JTab-MemRd(WordIndexed(JTab,-1))-2+CurrentIpc);
  624. #endif
  625.   MemWr(MISCINFO, MemRd(MISCINFO) & ~(1<<10));
  626. #else
  627.   /* Early versions of Apple Pascal do contain the code to directly
  628.      print this offset.  A bit in system.miscinfo is checked in the
  629.      system error handler to see, wether BOMBIPC does contain a
  630.      pointer or an offset. */
  631.   MemWr(BOMBIPC, CurrentIpc);
  632.   MemWr(MISCINFO, MemRd(MISCINFO) | 1<<10);
  633. #endif
  634.  
  635.   call(NewSeg, 2, BaseMp );
  636.   MemWr(BOMBP,   Mp);
  637.  
  638.   /* This code can be used to anter debugging upon entry of the system
  639.      error handler. It probably is only usefull to debug the system
  640.      error handler. */
  641. #ifdef XXX
  642.   TraceLevel=0x7fff;
  643.   warning ("XeqError(%d)", err);
  644. #endif
  645.   Flag--;
  646.   longjmp(ProcessNextInstrunction, 0);
  647. }
  648.  
  649. /****************************************************************************/
  650. /*                                        */
  651. /*        P-debugger stuff.                        */
  652. /*                                        */
  653.  
  654. /* Dump memory in decimal and in hex. Used to dump the evaluation stack */
  655. void ShowMem(word Start, word End)
  656. {
  657.   for ( ;Start<End; Start=WordIndexed(Start,1))
  658.     fprintf(stderr," %d(%x)",MemRd(Start), MemRd(Start));
  659.   fprintf(stderr,"\n");
  660. }
  661.  
  662. /* Disassemble a procedure */
  663. void List(FILE *out, int SegNo, word JTab)
  664. {
  665.   word    IpcBase=ProcBase(JTab);
  666.   word    Ipc=0;
  667.   char    Buffer[1024];
  668.   fprintf(out, "Params: %d, Vars: %d\n",
  669.      ProcParamSize(JTab)/2,
  670.      ProcDataSize(JTab)/2);
  671.   while (WordIndexed(IpcBase, Ipc/2)<JTab)
  672.     {
  673.       word OpCode=MemRdByte(IpcBase, Ipc);
  674.       sprintf(Buffer,"%d:    ", Ipc);
  675.       Ipc=DisasmP(Buffer+strlen(Buffer), SegNo, IpcBase, Ipc, JTab, 0);
  676.       fprintf(out, "%s\n", Buffer);
  677.       if ( (OpCode==RNP) ||
  678.        (OpCode==RBP) ||
  679.        (OpCode==XIT) )
  680.     return;
  681.     }
  682. }
  683.  
  684. void Debugger(void)
  685. {
  686.   char        prompt[64];
  687.   char        Buffer[256];
  688.   int        from,to;
  689.   char        Buf[10];
  690.   char        *line;
  691.   FILE        *out;
  692.   char        *mode;
  693.   int        (*close_method)(FILE*);
  694.  
  695.   if (Level>TraceLevel)
  696.     return;
  697.   TraceLevel=0x7fff;
  698.  
  699.   DisasmP(Buffer, SegNumber(Seg), IpcBase, Ipc, JTab, Sp);
  700.   snprintf(prompt, sizeof(prompt), "s%d, p%d, %4d:    %s    > ", SegNumber(Seg), ProcNumber(JTab), 
  701.         CurrentIpc, Buffer);
  702.  
  703.   do
  704.     {
  705.       Buffer[0]='\0';
  706.       fprintf(stderr,"%s", prompt);
  707.       fgets(Buffer, sizeof(Buffer)-1, stdin);
  708.  
  709.       close_method = NULL;
  710.       out = NULL;
  711.       line=Buffer;
  712.       while (*line)
  713.     if ( (*line == '|')||  (*line == '>') )
  714.       break;
  715.     else
  716.       line++;
  717.  
  718.       if (*line == '|')
  719.     {
  720.       *line='\0';
  721.       line++;
  722.       while (*line)
  723.         if (isspace(*line))
  724.           line++;
  725.         else
  726.           break;
  727.       out = popen(line, "w");
  728.       close_method = pclose;
  729.     }
  730.       else if (*line == '>')
  731.     {
  732.       *line='\0';
  733.       line++;
  734.       if (*line == '>')
  735.         {
  736.           line++;
  737.           mode="a";
  738.         }
  739.       else
  740.         mode="w";
  741.       while (*line)
  742.         if (isspace(*line))
  743.           line++;
  744.         else
  745.           break;
  746.       out = fopen(line, mode);
  747.       close_method = fclose;
  748.     }
  749.       if (!out)
  750.     {
  751.       close_method = NULL;
  752.       out=stderr;
  753.     }
  754.  
  755.       switch (Buffer[0])
  756.     {
  757.     case 'p':        /* print stack */
  758.       fprintf(stderr,"Stack:");
  759.       ShowMem(Sp,SP_TOP);
  760.       break;
  761.     case 'd':
  762.       switch (sscanf(Buffer, "%10s %x %x", Buf, &from, &to))
  763.         {
  764.           /*
  765.         case 1:
  766.           from=NextDumpAddr;
  767.           */
  768.         case 2:
  769.           to=from+0x80;
  770.         case 3:
  771.           MemDump(out, from,to);
  772.           break;
  773.         default:
  774.           fprintf(stderr,"d <from> [<to>]\n");
  775.         }
  776.       break;
  777.     case 'l':
  778.       {
  779.         int SegNo;
  780.         int ProcNo;
  781.         switch (sscanf(Buffer, "%10s %d %d", Buf, &SegNo, &ProcNo))
  782.           {
  783.           case 2:
  784.         ProcNo=SegNo;
  785.         SegNo=SegNumber(Seg);
  786.           case 3:
  787.         if (SegNo<NUMBER(SegDict))
  788.           {
  789.             CspLoadSegment(SegNo);
  790.             List(out, SegNo, Proc(SegDict[SegNo].Seg, ProcNo));
  791.             CspUnloadSegment(SegNo);
  792.           }
  793.         break;
  794.           default:
  795.         fprintf(stderr,"l [<SegNo>] <ProcNo>\n");
  796.           }
  797.       }
  798.       break;
  799.     case 't':
  800.       {
  801.         word s=Seg;
  802.         word j=JTab;
  803.         word m=Mp;
  804.         word i=Ipc;
  805.         
  806.         while (1)
  807.           {
  808.         word w;
  809.         fprintf(out,"\ns%d, p%d, %4d:\n",
  810.             SegNumber(s), ProcNumber(j), i);
  811.         w=WordIndexed(m, MS_VAR);
  812.         MemDump(out, w,w+ProcParamSize(j)+ProcDataSize(j));
  813.         
  814.         if (ProcLexLevel(j)<0)
  815.           break;
  816.         j = MemRd(WordIndexed(m,MS_JTAB));
  817.         s = MemRd(WordIndexed(m,MS_SEG));
  818.         i = MemRd(WordIndexed(m,MS_IPC));
  819.         m = MemRd(WordIndexed(m,MS_DYN));
  820.           }
  821.       }
  822.       MemDump(out, Kp, 0xb000);
  823.       break;
  824.     case 'v':
  825.       MemDump(out, WordIndexed(Mp,MS_VAR), WordIndexed(Mp,MS_VAR)+ProcDataSize(JTab)+ProcParamSize(JTab));
  826.       break;
  827.     case 'g':
  828.       TraceLevel=0;
  829.       return;
  830.     case 'n':
  831.       TraceLevel=Level;
  832.       return;
  833.     case 'f':
  834.       TraceLevel=Level-1;
  835.       return;
  836.     case 'r':
  837.       fprintf(out,"Sp=%04x, Kp=%04x, Mp=%04x, Base=%04x, Seg=%04x, JTab=%04x, Np=%04x\n",
  838.           Sp, Kp, Mp, Base, Seg, JTab, Np);
  839.       break;
  840.     case 'q':
  841.       if (TraceFile)
  842.         fclose(TraceFile);
  843.       exit(0);
  844.       break;
  845.     }
  846.       if (close_method && out)
  847.     {
  848.       close_method(out);
  849.       close_method=NULL;
  850.       out=NULL;
  851.     }
  852.     } while (Buffer[0]!='\n');
  853. }
  854.  
  855. /****************************************************************************/
  856. /*                                        */
  857. /*        P-tracing stuff.                        */
  858. /*                                        */
  859.  
  860. /* To compare traces with byte and word architecture, this routine
  861.    tries to 'normalize' the value of pointers. Of course, the
  862.    assumtions are not always true, but the diffs get a lot shorter
  863.    using this translation. :-) */
  864. inline word Translate(word Value)
  865. {
  866. #ifdef TRACE_TRANSLATE
  867. #ifdef WORD_MEMORY
  868.   if (Value>KP_TOP)
  869.     ;
  870.   else if (Value>0x8000)
  871.     Value = (Value-KP_TOP)*2+KP_TOP;
  872.   else if (Value>0x7f00)
  873.     ;
  874.   else if (Value >HEAP_BOT)
  875.     Value = (Value-HEAP_BOT)*2+HEAP_BOT;
  876. #endif
  877. #endif
  878.   return(Value);
  879. }
  880.  
  881. void Tracer(void)
  882. {
  883.   char    Buffer[64000];
  884.   char    StackBuf[1024];
  885.   char    *p=StackBuf;
  886.   word  w=Sp;
  887.  
  888.   *p='\0';
  889.   while (w<SP_TOP)
  890.     {
  891.       word Value=MemRd(w);
  892.  
  893.       sprintf(p,"%04x ",Translate(Value));
  894.       p+=strlen(p);
  895.       w=WordIndexed(w,1);
  896.     }
  897.  
  898.   DisasmP(Buffer, MemRd(Seg)&0xff, IpcBase, Ipc, JTab, Sp);
  899.  
  900.   fprintf(TraceFile,"s%d p%d o%d    %s    Stack: %s\n",
  901.       MemRd(Seg)&0xff, MemRd(JTab)&0xff, Ipc, Buffer, StackBuf);
  902.  
  903.   fflush(TraceFile);
  904. }
  905.  
  906. void SetTrace(char *list)
  907. {
  908.   int i,j;
  909.   char *p;
  910.  
  911.   p=strchr(list, ',');
  912.   switch(sscanf(list, "%d,%d", &i, &j))
  913.     {
  914.     case 1:
  915.       TraceProc=i;
  916.       break;
  917.     case 2:
  918.       TraceSeg=i;
  919.       TraceProc=j;
  920.       break;
  921.     default:
  922.       fprintf(stderr,"invalid trace flags\n");
  923.       exit(1);
  924.     }
  925. }
  926.  
  927. /****************************************************************************/
  928. /*                                        */
  929. /*        The P-machine itself.                        */
  930. /*                                        */
  931.  
  932. int AppleHack1(void)
  933. {
  934.   word Save0=Ipc;
  935.  
  936.   if (FetchUB() == 145)                /* NGI */
  937.     {
  938.       word OpCode=FetchUB();
  939.       if (OpCode == 171)            /* SRO */
  940.     {
  941.       word Var=FetchB();            /* Parameter SRO */
  942.       OpCode=FetchUB();
  943.       if ((((OpCode   == 169) &&        /* LDO n */
  944.         (FetchB() == Var)) ||
  945.            ((Var>=1) && (Var<=16) &&
  946.         (OpCode   == 231+Var))) &&    /* SLDO n */
  947.           (FetchUB()  ==   0) &&        /* SLCD    0 */
  948.           (FetchUB()  == 190) )        /* LDB */
  949.         return(1);
  950.     }
  951.       else if (OpCode == 204)            /* STL */
  952.     {
  953.       word Var=FetchB();            /* Parameter STL */
  954.       OpCode=FetchUB();
  955.       if ((((OpCode   == 202) &&        /* LDL  n */
  956.         (FetchB() == Var)) ||
  957.            ((Var>=1) && (Var<=16) &&
  958.         (OpCode   == 215+Var))) &&    /* SLDL n */
  959.           (FetchUB()  ==   0) &&        /* SLCD    0 */
  960.           (FetchUB()  == 190) )        /* LDB */
  961.         return(1);
  962.     }
  963.     }
  964.   Ipc=Save0;
  965.   return(0);
  966. }
  967.  
  968. int AppleHack2(void)
  969. {
  970.   word Save=Ipc;
  971.   word Var;
  972.  
  973.   if ( (FetchUB() == 145) &&        /* NGI */
  974.        (FetchUB() == 171) &&        /* SRO */
  975.        (Var=FetchB()) &&        /* Parameter SRO */
  976.        (FetchUB() == 169) &&        /* LDO n */
  977.        (FetchB()  == Var) &&
  978.        (FetchUB() == 6) &&        /* SLDC 6 */
  979.        (FetchUB() == 192) &&        /* IXP 16,1 */
  980.        (FetchUB() == 16) &&
  981.        (FetchUB() == 1) &&
  982.        (FetchUB() == 186))        /* LDP */
  983.     return(1);
  984.   Ipc=Save;
  985.   return(0);
  986. }
  987.  
  988. void Processor(void)
  989. {
  990.   byte    Opcode;
  991.   word    w;
  992.   float    f;
  993.   register word    p1, p2;
  994.  
  995.   setjmp(ProcessNextInstrunction);
  996.   for ( ; /* ever */ ; )
  997.     {
  998.       /* CheckCallStack(); */
  999.       if (TraceFile)
  1000.     if (!TraceProc ||
  1001.         ( (TraceProc == ProcNumber(JTab)) &&
  1002.           (TraceSeg  == SegNumber(Seg) ) ) )
  1003.       Tracer();
  1004.  
  1005.       Debugger();
  1006.  
  1007.       CurrentIpc = Ipc;
  1008.       Opcode = FetchUB();        /* fetch next instruction */
  1009.       switch (Opcode)
  1010.     {
  1011.         /* One-word load and stores constant */
  1012.     case SLDC_0:    case SLDC_1:    case SLDC_2:    case SLDC_3:
  1013.     case SLDC_4:    case SLDC_5:    case SLDC_6:    case SLDC_7:
  1014.     case SLDC_8:    case SLDC_9:    case SLDC_10:    case SLDC_11:
  1015.     case SLDC_12:    case SLDC_13:    case SLDC_14:    case SLDC_15:
  1016.     case SLDC_16:    case SLDC_17:    case SLDC_18:    case SLDC_19:
  1017.     case SLDC_20:    case SLDC_21:    case SLDC_22:    case SLDC_23:
  1018.     case SLDC_24:    case SLDC_25:    case SLDC_26:    case SLDC_27:
  1019.     case SLDC_28:    case SLDC_29:    case SLDC_30:    case SLDC_31:
  1020.     case SLDC_32:    case SLDC_33:    case SLDC_34:    case SLDC_35:
  1021.     case SLDC_36:    case SLDC_37:    case SLDC_38:    case SLDC_39:
  1022.     case SLDC_40:    case SLDC_41:    case SLDC_42:    case SLDC_43:
  1023.     case SLDC_44:    case SLDC_45:    case SLDC_46:    case SLDC_47:
  1024.     case SLDC_48:    case SLDC_49:    case SLDC_50:    case SLDC_51:
  1025.     case SLDC_52:    case SLDC_53:    case SLDC_54:    case SLDC_55:
  1026.     case SLDC_56:    case SLDC_57:    case SLDC_58:    case SLDC_59:
  1027.     case SLDC_60:    case SLDC_61:    case SLDC_62:    case SLDC_63:
  1028.     case SLDC_64:    case SLDC_65:    case SLDC_66:    case SLDC_67:
  1029.     case SLDC_68:    case SLDC_69:    case SLDC_70:    case SLDC_71:
  1030.     case SLDC_72:    case SLDC_73:    case SLDC_74:    case SLDC_75:
  1031.     case SLDC_76:    case SLDC_77:    case SLDC_78:    case SLDC_79:
  1032.     case SLDC_80:    case SLDC_81:    case SLDC_82:    case SLDC_83:
  1033.     case SLDC_84:    case SLDC_85:    case SLDC_86:    case SLDC_87:
  1034.     case SLDC_88:    case SLDC_89:    case SLDC_90:    case SLDC_91:
  1035.     case SLDC_92:    case SLDC_93:    case SLDC_94:    case SLDC_95:
  1036.     case SLDC_96:    case SLDC_97:    case SLDC_98:    case SLDC_99:
  1037.     case SLDC_100:    case SLDC_101:    case SLDC_102:    case SLDC_103:
  1038.     case SLDC_104:    case SLDC_105:    case SLDC_106:    case SLDC_107:
  1039.     case SLDC_108:    case SLDC_109:    case SLDC_110:    case SLDC_111:
  1040.     case SLDC_112:    case SLDC_113:    case SLDC_114:    case SLDC_115:
  1041.     case SLDC_116:    case SLDC_117:    case SLDC_118:    case SLDC_119:
  1042.     case SLDC_120:    case SLDC_121:    case SLDC_122:    case SLDC_123:
  1043.     case SLDC_124:    case SLDC_125:    case SLDC_126:    case SLDC_127:
  1044.       Push( Opcode-SLDC_0 );    /* SLDC 0..127 Short LoaD Constant */
  1045.       break;
  1046.     case LDCN:            /* LDCN LoaD Constant Nil */
  1047.       Push( NIL );
  1048.       break;
  1049.     case LDCI:            /* LDCI LoaD Constant Integer */
  1050.       p1=FetchW();
  1051.       if (p1 == 16607)        /* Apple-Hack */
  1052.         if (AppleHack1())
  1053.           Push(4);
  1054.         else
  1055.           Push( p1 );
  1056.       else if (p1 == 16606)
  1057.         if (AppleHack2())
  1058.           Push(Boolean(0));
  1059.         else
  1060.           Push( p1 );
  1061.       else
  1062.         Push( p1 );
  1063.       break;
  1064.  
  1065.             /* One-word load and stores local */
  1066.                     /* SLDL Short LoaD Local 1..16 */
  1067.     case SLDL_1:    case SLDL_2:    case SLDL_3:    case SLDL_4:
  1068.     case SLDL_5:    case SLDL_6:    case SLDL_7:    case SLDL_8:
  1069.     case SLDL_9:    case SLDL_10:    case SLDL_11:    case SLDL_12:
  1070.     case SLDL_13:    case SLDL_14:    case SLDL_15:    case SLDL_16:
  1071.       Push( MemRd( LocalAddr( Opcode-SLDL_1+1 )));
  1072.       break;
  1073.     case LDL:            /* LDL LoaD Local */
  1074.       Push( MemRd( LocalAddr( FetchB() ) ) );
  1075.       break;
  1076.     case LLA:            /* LLA Load Local Addres */
  1077.       Push( LocalAddr( FetchB() ) );
  1078.       break;
  1079.     case STL:            /* STL STore Local */
  1080.       MemWr( LocalAddr( FetchB() ), Pop() );
  1081.       break;
  1082.       
  1083.             /* One-word load and stores global */
  1084.                     /* SLDO Short LoaD glObal word */
  1085.     case SLDO_1:    case SLDO_2:    case SLDO_3:    case SLDO_4:
  1086.     case SLDO_5:    case SLDO_6:    case SLDO_7:    case SLDO_8:
  1087.     case SLDO_9:    case SLDO_10:    case SLDO_11:    case SLDO_12:
  1088.     case SLDO_13:    case SLDO_14:    case SLDO_15:    case SLDO_16:
  1089.       Push( MemRd( GlobalAddr( Opcode-SLDO_1+1 )));
  1090.       break;
  1091.     case LDO:            /* LDO LoaD glObal */
  1092.       Push( MemRd( GlobalAddr( FetchB() )));
  1093.       break;
  1094.     case LAO:            /* LAO Load Address glObal */
  1095.       Push( GlobalAddr( FetchB() ));
  1096.       break;
  1097.     case SRO:            /* SRO StoRe glObal */
  1098.       MemWr( GlobalAddr( FetchB() ), Pop() );
  1099.       break;
  1100.  
  1101.         /* One-word load and stores intermediate */
  1102.     case LOD:            /* LOD LOaD */
  1103.       p1 = FetchUB(); Push( MemRd( IntermediateAddr( FetchB(), p1 )));
  1104.       break;
  1105.     case LDA:            /* LDA LOad Addres */
  1106.       p1 = FetchUB(); Push( IntermediateAddr( FetchB(), p1 ));
  1107.       break;
  1108.     case STR:            /* STR StoRe */
  1109.       p1 = FetchUB(); MemWr( IntermediateAddr( FetchB(), p1 ), Pop());
  1110.       break;
  1111.  
  1112.             /* One-word load and stores indirect */
  1113.                     /* SIND Short INDirect */
  1114.     case SIND_0:    case SIND_1:    case SIND_2:    case SIND_3:
  1115.     case SIND_4:    case SIND_5:    case SIND_6:    case SIND_7:
  1116.       Push( MemRd( WordIndexed( Pop(), Opcode-SIND_0 )));
  1117.       break;
  1118.     case IND:            /* IND INDirect */
  1119.       Push( MemRd( WordIndexed( Pop(), FetchB() )));
  1120.       break;
  1121.     case STO:            /* STO STOre indirect */
  1122.       p1 = Pop(); MemWr( Pop(), p1 );
  1123.       break;
  1124.         
  1125.             /* One-word load and stores indirect */
  1126.     case LDE:            /* LDE LoaD Extended */
  1127.       p1 = FetchUB(); Push( MemRd( ExtendedAddr( FetchB(), p1 )));
  1128.       break;
  1129.     case LAE:            /* LAE Load Addres Extended */
  1130.       p1 = FetchUB(); Push( ExtendedAddr( FetchB(), p1 ));
  1131.       break;
  1132.     case STE:            /* STE STore Extended */
  1133.       p1 = FetchUB(); MemWr( ExtendedAddr( FetchB(), p1 ), Pop() );
  1134.       break;
  1135.                 /* multiple-word loads and stores */
  1136.     case LDC:
  1137.       p1=FetchUB();
  1138.       Ipc=(Ipc+1)&(~1);        /* Nur auf Wortgrenze erlaubt */
  1139. #ifdef WORD_MEMORY
  1140.       w=IpcBase+Ipc/2;
  1141. #else
  1142.       w=IpcBase+Ipc;
  1143. #endif
  1144.       while (p1--)
  1145.         Push( FetchW() );
  1146.       break;
  1147.     case LDM:
  1148.       p1=FetchUB();
  1149.       w=Pop();
  1150.       while (p1--)
  1151.         Push( MemRd( WordIndexed( w, p1 )));
  1152.       break;
  1153.     case STM:
  1154.       p1=FetchUB();
  1155.       w=MemRd(WordIndexed(Sp,p1));
  1156.       while (p1--)
  1157.         {
  1158.           MemWr(w, Pop());
  1159.           w=WordIndexed(w,1);
  1160.         }
  1161.       Pop();
  1162.       break;
  1163.                 /* byte array handling */
  1164.     case LDB:
  1165.       w=Pop(); Push(MemRdByte(Pop(), w));
  1166.       break;
  1167.     case STB:
  1168.       p1=Pop(); w=Pop(); MemWrByte(Pop(), w, p1);
  1169.       break;
  1170.                 /* string handling */
  1171.     case LSA:
  1172.       assert(!(Ipc&1));
  1173.       Push( WordIndexed( IpcBase, Ipc/2 ) );
  1174.       Ipc += FetchUB();
  1175.       break;
  1176.     case SAS:
  1177.       p1=FetchUB();
  1178.       if ((w=Pop())&0xff00)
  1179.         {            /* copy String */
  1180.           byte Len=MemRdByte(w, 0);
  1181.           word Dest=Pop();
  1182.           if (Len>p1)
  1183.         XeqError(XS2LONG);
  1184.           MoveLeft(Dest, 0, w, 0, Len+1);
  1185.         }
  1186.       else
  1187.         {            /* store Char */
  1188.           word Dest=Pop();
  1189.           MemWrByte(Dest, 0, 1);    /* make string of len 1            */
  1190.           MemWrByte(Dest, 1, w);    /* containing char on stack        */
  1191.         }
  1192.       break;
  1193.     case IXS:
  1194.       p1=Pop();  p2=Pop();
  1195.       Push(p2);  Push(p1);
  1196.       if (p1>MemRdByte(p2, 0))
  1197.         XeqError(XINVNDX);
  1198.       break;
  1199.                 /* record and array handling */
  1200.     case MOV:
  1201.       p1=FetchB();
  1202.       {
  1203.         word    Src=Pop();
  1204.         word    Dst=Pop();
  1205.         while (p1--)
  1206.           {
  1207.         MemWr(Dst, MemRd(Src));
  1208.         Dst=WordIndexed(Dst,1);
  1209.         Src=WordIndexed(Src,1);
  1210.           }
  1211.       }
  1212.       break;
  1213.     case INC:
  1214.       Push( WordIndexed( Pop(), FetchB() ) );
  1215.       break;
  1216.     case IXA:
  1217.       w=Pop();
  1218.       Push( WordIndexed( Pop(), w*FetchB() ) );
  1219.       break;
  1220.     case IXP:
  1221.       p1 = FetchUB(); p2 = FetchUB(); w=Pop();
  1222.       Push(WordIndexed(Pop(),w/p1)); /* Address */
  1223.       Push(p2);
  1224.       Push((w%p1)*p2
  1225. #ifdef IXP_COMPATIBILITY
  1226.            *0x101
  1227. #endif
  1228.            );
  1229.       break;
  1230.     case LPA:
  1231.       p1=FetchB();
  1232. #ifdef WORD_MEMORY
  1233.       Push(IpcBase+Ipc/2);
  1234. #else
  1235.       Push(IpcBase+Ipc);
  1236. #endif
  1237.       Ipc+=p1;
  1238.       break;
  1239.     case LDP:
  1240.       {
  1241.         word Offset=Pop()&0xff;
  1242.         word Size=Pop();
  1243.         word Addr=Pop();
  1244.         if (Offset+Size>16)
  1245.           {
  1246.         warning("LDP: Offset(%d)+Size(%d) > Bits per word",
  1247.             Offset, Size);
  1248.         XeqError(XINVNDX);
  1249.           }
  1250.         Push((MemRd(Addr)>>Offset)&((1<<Size)-1));
  1251.       }
  1252.       break;
  1253.     case STP:
  1254.       w=Pop();
  1255.       {
  1256.         word Offset=Pop()&0xff;
  1257.         word Size=Pop();
  1258.         word Addr=Pop();
  1259.         if (Offset+Size>16)
  1260.           {
  1261.         warning("STP: Offset(%d)+Size(%d) > Bits per word",
  1262.             Offset, Size);
  1263.         XeqError(XINVNDX);
  1264.           }
  1265.         w &= (1<<Size)-1;
  1266.         MemWr(Addr, 
  1267.           (MemRd(Addr) & ~(((1<<Size)-1)<<Offset)) | (w<<Offset));
  1268.       }
  1269.       break;
  1270.                 /* TOS arithmetic: integers */
  1271.     case ABI:            /* ABI ABsolute Integer */
  1272.       Push( abs( PopInteger()));
  1273.       break;
  1274.     case ADI:
  1275.       Push( PopInteger() + PopInteger() );
  1276.       break;
  1277.     case NGI:
  1278.       Push( -PopInteger() );
  1279.       break;
  1280.     case SBI:
  1281.       {
  1282.         Integer i=PopInteger();
  1283.         Push( PopInteger()-i );
  1284.       }
  1285.       break;
  1286.     case MPI:
  1287.       Push( PopInteger() * PopInteger() );
  1288.       break;
  1289.     case SQI:
  1290.       {
  1291.         Integer i=PopInteger();
  1292.         Push( i*i );
  1293.       }
  1294.       break;
  1295.     case DVI:
  1296.       {
  1297.         Integer i=PopInteger();
  1298.         if (!i)
  1299.           XeqError(XDIVZER);
  1300.         Push( PopInteger() / i );
  1301.       }
  1302.       break;
  1303.     case MODI:
  1304.       {
  1305.         Integer i=PopInteger(); 
  1306.         if (!i)
  1307.           XeqError(XDIVZER);
  1308.         Push( PopInteger() % i );
  1309.       }
  1310.       break;
  1311.     case CHK:
  1312.       {
  1313.         Integer Upper=PopInteger();
  1314.         Integer Lower=PopInteger();
  1315.         Integer Value=PopInteger();
  1316.         Push(Value);
  1317.         if ( (Value>Upper) || (Value<Lower) )
  1318.           XeqError(XINVNDX);
  1319.       }
  1320.       break;
  1321.     case EQUI:
  1322.       {
  1323.         Integer i=PopInteger();
  1324.         Push ( Boolean ( PopInteger() == i ) );
  1325.       }
  1326.       break;
  1327.     case NEQI:
  1328.       {
  1329.         Integer i=PopInteger();
  1330.         Push ( Boolean ( PopInteger() != i ) );
  1331.       }
  1332.       break;
  1333.     case LEQI:
  1334.       {
  1335.         Integer i=PopInteger();
  1336.         Push ( Boolean ( PopInteger() <= i ) );
  1337.       }
  1338.       break;
  1339.     case LESI:
  1340.       {
  1341.         Integer i=PopInteger();
  1342.         Push ( Boolean ( PopInteger() < i ) );
  1343.       }
  1344.       break;
  1345.     case GEQI:
  1346.       {
  1347.         Integer i=PopInteger();
  1348.         Push ( Boolean ( PopInteger() >= i ) );
  1349.       }
  1350.       break;
  1351.     case GRTI:
  1352.       {
  1353.         Integer i=PopInteger();
  1354.         Push ( Boolean ( PopInteger() > i ) );
  1355.       }
  1356.       break;
  1357.                 /* TOS arithmetic: reals */
  1358.     case FLT:
  1359.       PushReal(PopInteger());
  1360.       break;
  1361.     case FLO:
  1362.       f=PopReal();
  1363.       PushReal(PopInteger());
  1364.       PushReal(f);
  1365.       break;
  1366.     case ABR:
  1367.       PushReal(fabs(PopReal()));
  1368.       break;
  1369.     case ADR:
  1370.       PushReal(PopReal()+PopReal());
  1371.       break;
  1372.     case NGR:
  1373.       PushReal(-PopReal());
  1374.       break;
  1375.     case SBR:
  1376.       f=PopReal();
  1377.       PushReal(PopReal()-f);
  1378.       break;
  1379.     case MPR:
  1380.       PushReal(PopReal()*PopReal());
  1381.       break;
  1382.     case SQR:
  1383.       f=PopReal();
  1384.       PushReal(f*f);
  1385.       break;
  1386.     case DVR:
  1387.       if ((f=PopReal())==0)
  1388.         XeqError(XDIVZER);
  1389.       PushReal(PopReal()/f);
  1390.       break;
  1391.  
  1392.     case EQU:
  1393.       switch(FetchUB())
  1394.         {
  1395.         case 2:
  1396.           f=PopReal(); Push(Boolean( PopReal() == f ));
  1397.           break;
  1398.         case 4:
  1399.           w=Pop(); Push(Boolean(StrCmp(Pop(), w) == 0));
  1400.           break;
  1401.         case 6:
  1402.           Push(Boolean((Pop()&1)==(Pop()&1)));
  1403.           break;
  1404.         case 8:
  1405.           {
  1406.         Set_t Set1;
  1407.         Set_t Set2;
  1408.         SetPop(&Set1);
  1409.         SetPop(&Set2);
  1410.         Push(Boolean(SetCmp(&Set1, &Set2) == 0));
  1411.         break;
  1412.           }
  1413.         case 10:
  1414.           w=Pop(); Push(Boolean(ByteCmp(Pop(), w, FetchB() ) == 0));
  1415.           break;
  1416.         case 12:
  1417.           p1=FetchB();
  1418.           w=Pop();
  1419.           Push(Boolean(WordCmp(Pop(), w, p1) == 0));
  1420.           break;
  1421.         default:
  1422.           XeqError(XNOTIMP);
  1423.         }
  1424.       break;
  1425.     case NEQ:
  1426.       switch(FetchUB())
  1427.         {
  1428.         case 2:
  1429.           f=PopReal(); Push(Boolean( PopReal() != f ));
  1430.           break;
  1431.         case 4:
  1432.           w=Pop(); Push(Boolean(StrCmp(Pop(), w) != 0));
  1433.           break;
  1434.         case 6:
  1435.           Push(Boolean((Pop()&1)!=(Pop()&1)));
  1436.           break;
  1437.         case 8:
  1438.           {
  1439.         Set_t Set1;
  1440.         Set_t Set2;
  1441.         SetPop(&Set1);
  1442.         SetPop(&Set2);
  1443.         Push(Boolean(SetCmp(&Set1, &Set2) != 0));
  1444.         break;
  1445.           }
  1446.         case 10:
  1447.           w=Pop(); Push(Boolean(ByteCmp(Pop(), w, FetchB() ) != 0));
  1448.           break;
  1449.         case 12:
  1450.           p1=FetchB();
  1451.           w=Pop();
  1452.           Push(Boolean(WordCmp(Pop(), w, p1) != 0));
  1453.           break;
  1454.         default:
  1455.           XeqError(XNOTIMP);
  1456.         }
  1457.       break;
  1458.       
  1459.     case LEQ:
  1460.       switch(FetchUB())
  1461.         {
  1462.         case 2:
  1463.           f=PopReal(); Push(Boolean( PopReal() <= f ));
  1464.           break;
  1465.         case 4:
  1466.           w=Pop(); Push(Boolean(StrCmp(Pop(), w) <= 0) );
  1467.           break;
  1468.         case 6:
  1469.           w=Pop()&1; Push(Boolean((Pop()&1) <= w));
  1470.           break;
  1471.         case 8:
  1472.           {
  1473.         Set_t Set1;
  1474.         Set_t Set2;
  1475.         SetPop(&Set1);
  1476.         SetPop(&Set2);
  1477.         Push(Boolean(SetIsSubset(&Set1, &Set2)));
  1478.         break;
  1479.           }
  1480.           break;
  1481.         case 10:
  1482.           w=Pop(); Push(Boolean(ByteCmp(Pop(), w, FetchB()) <= 0));
  1483.           break;
  1484.         default:
  1485.           XeqError(XNOTIMP);
  1486.         }
  1487.       break;
  1488.  
  1489.     case LES:
  1490.       switch(FetchUB())
  1491.         {
  1492.         case 2:
  1493.           f=PopReal(); Push(Boolean( PopReal() < f ));
  1494.           break;
  1495.         case 4:
  1496.           w=Pop(); Push(Boolean(StrCmp(Pop(), w) < 0) );
  1497.           break;
  1498.         case 6:
  1499.           w=Pop()&1; Push(Boolean((Pop()&1) < w));
  1500.           break;
  1501.         case 10:
  1502.           w=Pop(); Push(Boolean(ByteCmp(Pop(), w, FetchB()) < 0));
  1503.           break;
  1504.         default:
  1505.           XeqError(XNOTIMP);
  1506.         }
  1507.       break;
  1508.       
  1509.     case GEQ:
  1510.       switch(FetchUB())
  1511.         {
  1512.         case 2:
  1513.           f=PopReal(); Push(Boolean( PopReal() >= f ));
  1514.           break;
  1515.         case 4:
  1516.           w=Pop(); Push(Boolean(StrCmp(Pop(), w) >= 0) );
  1517.           break;
  1518.         case 6:
  1519.           w=Pop()&1; Push(Boolean((Pop()&1) >= w));
  1520.           break;
  1521.         case 8:
  1522.           {
  1523.         Set_t Set1;
  1524.         Set_t Set2;
  1525.         SetPop(&Set1);
  1526.         SetPop(&Set2);
  1527.         Push(Boolean(SetIsSubset(&Set2, &Set1)));
  1528.         break;
  1529.           }
  1530.           break;
  1531.         case 10:
  1532.           w=Pop(); Push(Boolean(ByteCmp(Pop(), w, FetchB()) >= 0));
  1533.           break;
  1534.         default:
  1535.           XeqError(XNOTIMP);
  1536.         }
  1537.       break;
  1538.  
  1539.     case GRT:
  1540.       switch(FetchUB())
  1541.         {
  1542.         case 2:
  1543.           f=PopReal(); Push(Boolean( PopReal() > f ));
  1544.           break;
  1545.         case 4:
  1546.           w=Pop(); Push(Boolean(StrCmp(Pop(), w) > 0) );
  1547.           break;
  1548.         case 6:
  1549.           w=Pop()&1; Push(Boolean((Pop()&1) > w));
  1550.           break;
  1551.         case 10:
  1552.           w=Pop(); Push(Boolean(ByteCmp(Pop(), w, FetchB()) > 0));
  1553.           break;
  1554.         default:
  1555.           XeqError(XNOTIMP);
  1556.         }
  1557.       break;
  1558.                 /* TOS arithmetic: logical */
  1559.     case LAND:
  1560.       Push( Pop() & Pop() );
  1561.       break;
  1562.     case LOR:
  1563.       Push( Pop() | Pop() );
  1564.       break;
  1565.     case LNOT:
  1566.       Push( ~Pop() );
  1567.       break;
  1568.                 /* Sets */
  1569.     case ADJ:
  1570.       p1=FetchUB();
  1571.       w=MemRd(Sp);
  1572.       if (p1!=w)
  1573.         {
  1574.           Set_t Buf;
  1575.           SetPop(&Buf);
  1576.           SetAdj(&Buf, p1);
  1577.           SetPush(&Buf);
  1578.         }
  1579.       if (p1!=Pop())
  1580.         panic("adj failure");
  1581.       break;
  1582.     case SGS:
  1583.       w=Pop();
  1584.       if (w<512)
  1585.         {
  1586.           int    Size=(w+16)/16;
  1587.           word    Addr;
  1588.           int    i;
  1589.           for (i=0;i<Size;i++)
  1590.         Push(0);
  1591.           Addr=WordIndexed(Sp, w/16);
  1592.           MemWr(Addr, MemRd(Addr)|(1<<w%16));
  1593.           Push(Size);
  1594.         }
  1595.       else
  1596.         XeqError(XINVNDX);
  1597.       break;
  1598.     case SRS:
  1599.       p1=Pop();
  1600.       p2=Pop();
  1601.       if ((p1<512) && (p1<512) )
  1602.         {
  1603.           if (p2>p1)
  1604.         Push(0);
  1605.           else
  1606.         {
  1607.           int    Size=(p1+16)/16;
  1608.           word    Addr;
  1609.           int    i;
  1610.           for (i=0;i<Size;i++)
  1611.             Push(0);
  1612.           while (p2<=p1)
  1613.             {
  1614.               Addr=WordIndexed(Sp, p2/16);
  1615.               MemWr(Addr, MemRd(Addr)|(1<<p2%16));
  1616.               p2++;
  1617.             }
  1618.           Push(Size);
  1619.         }
  1620.         }
  1621.       else
  1622.         XeqError(XINVNDX);
  1623.       break;
  1624.     case INN:
  1625.       {
  1626.         word Size;
  1627.         word Addr;
  1628.         word Val;
  1629.         Size=Pop();
  1630.         Addr=Sp;
  1631.         Sp=WordIndexed(Sp,Size);
  1632.         Val=Pop();
  1633.         if (Val>=16*Size)
  1634.           Push(Boolean(0));
  1635.         else
  1636.           Push(Boolean(MemRd(WordIndexed(Addr,(Val/16))) &
  1637.                (1<<(Val%16))));
  1638.       }
  1639.       break;
  1640.     case UNI:
  1641.       {
  1642.         int   i;
  1643.         word  Size;
  1644.         Set_t Set;
  1645.         
  1646.         SetPop(&Set);
  1647.         Size=Pop();
  1648.         if (Size>Set.Size)
  1649.           SetAdj(&Set, Size);
  1650.         
  1651.         for (i=0; i<Size; i++)
  1652.           Set.Data[i]|=Pop();
  1653.         SetPush(&Set);
  1654.       }
  1655.       break;
  1656.     case INT:
  1657.       {
  1658.         int   i;
  1659.         word  Size;
  1660.         Set_t Set;
  1661.         
  1662.         SetPop(&Set);
  1663.         Size=Pop();
  1664.         if (Size>Set.Size)
  1665.           SetAdj(&Set, Size);
  1666.         
  1667.         for (i=0; i<Size; i++)
  1668.           Set.Data[i]&=Pop();
  1669.         while(i<Set.Size)
  1670.           Set.Data[i++]=0;
  1671.         SetPush(&Set);
  1672.       }
  1673.       break;
  1674.  
  1675.     case DIF:
  1676.       {
  1677.         int   i;
  1678.         word  Size;
  1679.         Set_t Set;
  1680.         
  1681.         SetPop(&Set);
  1682.         Size=Pop();
  1683.         if (Size>Set.Size)
  1684.           SetAdj(&Set, Size);
  1685.         
  1686.         for (i=0; i<Size; i++)
  1687.           Set.Data[i] = Pop() & ~Set.Data[i];
  1688.         while (i<Set.Size)
  1689.           Set.Data[i]=0;
  1690.         SetPush(&Set);
  1691.       }
  1692.       break;
  1693.                 /* jumps */
  1694.     case UJP:
  1695.       w=jump((signed char)FetchUB());
  1696.       if ( ( Ipc-w == 5 ) &&        /* check for endless loop */
  1697.            ( MemRdByte(IpcBase, w  ) == SLDC_1 ) &&
  1698.            ( MemRdByte(IpcBase, w+1) == FJP    ) &&
  1699.            ( MemRdByte(IpcBase, w+2) == 2      ) )
  1700.         sleep(1);                /* reduce processor load */
  1701.       Ipc=w;
  1702.       break;
  1703.     case FJP:
  1704.       p1=FetchUB();
  1705.       if (! (Pop()&1) )
  1706.         {
  1707.           w=jump((signed char)p1);
  1708.           if ( ( Ipc-w == 3 ) &&        /* check for endless loop */
  1709.            ( MemRdByte(IpcBase, w  ) == SLDC_0 ) )
  1710.         sleep(1);            /* reduce processor load */
  1711.           Ipc=w;
  1712.         }
  1713.       break;
  1714.     case EFJ:
  1715.       p1=FetchUB();
  1716.       if ( Pop() != Pop() )
  1717.         Ipc=jump((signed char)p1);
  1718.       break;
  1719.     case NFJ:
  1720.       p1=FetchUB();
  1721.       if ( Pop() == Pop() )
  1722.         Ipc=jump((signed char)p1);
  1723.       break;
  1724.     case XJP:
  1725.       Ipc=(Ipc+1)&(~1);
  1726.       p1=FetchW(); p2=FetchW();
  1727.       w=Pop();
  1728.       if ( (w>=p1) && (w<=p2) )
  1729.         {
  1730.           Ipc=Ipc+2*(w-p1)+2;
  1731.           Ipc-=MemRd( WordIndexed( IpcBase, Ipc/2) );
  1732.         }
  1733.       break;
  1734.                 /* procedure and function calls */
  1735.     case CLP:
  1736.       call(Seg, FetchUB(), Mp);
  1737.       break;
  1738.     case CGP:
  1739.       call(Seg, FetchUB(), Base);
  1740.       break;
  1741.     case CIP:
  1742.       p1=FetchUB();
  1743.       call(Seg, p1, StaticLink(Seg, p1));
  1744.       break;
  1745.     case CBP:
  1746.       call(Seg, FetchUB(), BaseMp);
  1747.       break;
  1748.     case CXP:
  1749.       p1=FetchUB(); p2=FetchUB();
  1750.       if (p1)            /* Nicht bei Segment 0            */
  1751.         CspLoadSegment(p1);
  1752.       w=SegDict[p1].Seg;
  1753.       if (call(w, p2, StaticLink(w, p2) ))
  1754.         CspUnloadSegment(p1);
  1755.       break;
  1756.     case RNP:
  1757.       Sp  = MemRd(WordIndexed(Mp,MS_SP));
  1758.       ret(FetchUB());
  1759.       break;
  1760.     case RBP:
  1761.       Sp  = MemRd(WordIndexed(Mp,MS_SP));
  1762.       Base=Pop();
  1763.       MemWr(STKBASE, Base);
  1764.       if ( (Base<Kp) || (Base>BaseMp))
  1765.         panic("RBP: Base %04x out of range", Base);
  1766.       ret(FetchUB());
  1767.       break;
  1768.  
  1769.     case CSP:        /* CSP, Call Standard Procedure */
  1770.       switch(FetchUB())
  1771.         {
  1772.         case CSP_IOC:
  1773.           if (MemRd(IORSLT))
  1774.         XeqError(XUIOERR);
  1775.           break;
  1776.         case CSP_NEW:
  1777.           ClrGDirP();
  1778.           w=Pop();
  1779.           MemWr(Pop(),Np);
  1780.           Np=WordIndexed(Np, w);
  1781.           StackCheck();
  1782.           break;
  1783.         case CSP_MVL:
  1784.           {
  1785.         word    Len       = Pop();
  1786.         Integer DstOffset = PopInteger();
  1787.         word    Dst       = Pop();
  1788.         Integer SrcOffset = PopInteger();
  1789.         word    Src       = Pop();
  1790.         MoveLeft(Dst, DstOffset, Src, SrcOffset, Len);
  1791.           }
  1792.           break;
  1793.         case CSP_MVR:
  1794.           {
  1795.         word    Len       = Pop();
  1796.         Integer DstOffset = PopInteger();
  1797.         word    Dst       = Pop();
  1798.         Integer SrcOffset = PopInteger();
  1799.         word    Src       = Pop();
  1800.         MoveRight(Dst, DstOffset, Src, SrcOffset, Len);
  1801.           }
  1802.           break;
  1803.         case CSP_XIT:
  1804.           {
  1805.         word    ProcNo=Pop();
  1806.         word    SegNo=Pop();
  1807.         word    xMp=Mp;
  1808.         word    xSeg=Seg;
  1809.         word    xJTab=JTab;
  1810.         
  1811.         Ipc=ProcExitIpc(xJTab);
  1812.         while ( (ProcNumber(xJTab) != ProcNo) ||
  1813.             (SegNumber(xSeg)   != SegNo) )
  1814.           {
  1815.             if (!xMp ||
  1816.             !(xJTab = MemRd(WordIndexed(xMp, MS_JTAB))) ||
  1817.             !(xSeg  = MemRd(WordIndexed(xMp, MS_SEG))) )
  1818.               XeqError(XNOEXIT);
  1819.             
  1820.             MemWr(WordIndexed(xMp, MS_IPC), ProcExitIpc(xJTab));
  1821.             xMp   = MemRd(WordIndexed(xMp, MS_DYN));
  1822.           }
  1823.           }
  1824.           break;
  1825.         case CSP_UREAD:
  1826.           {
  1827.         word p1, p2, p3, p4, p5, p6;
  1828.         p6=Pop();p5=Pop();p4=Pop();
  1829.         p3=Pop();p2=Pop();p1=Pop();
  1830.         UnitRead(p1,p2,p3,p4,p5,p6);
  1831.           }
  1832.           break;
  1833.         case CSP_UWRITE:
  1834.           {
  1835.         word p1, p2, p3, p4, p5, p6;
  1836.         p6=Pop();p5=Pop();p4=Pop();
  1837.         p3=Pop();p2=Pop();p1=Pop();
  1838.         UnitWrite(p1,p2,p3,p4,p5,p6);
  1839.           }
  1840.           break;
  1841.         case CSP_TIM:
  1842.           {
  1843.         struct timeval tv;
  1844. #ifndef _AMIGA
  1845.         if (gettimeofday(&tv, NULL) <0)
  1846.           {
  1847.             perror("gettimeofday");
  1848.             MemWr(Pop(),0);
  1849.             MemWr(Pop(),0);
  1850.             MemWr( LOWTIME,  0 );
  1851.             MemWr( HIGHTIME, 0 );
  1852.           }
  1853.         else
  1854.           {
  1855.             tv.tv_sec = (tv.tv_usec*60*TIME_SCALE/1000000) 
  1856.               + tv.tv_sec*60*TIME_SCALE;
  1857.             MemWr( Pop(),    (tv.tv_sec>> 0)&0xffff );
  1858.             MemWr( LOWTIME,  (tv.tv_sec>> 0)&0xffff );
  1859.  
  1860.             MemWr( Pop(),    (tv.tv_sec>>16)&0xffff );
  1861.             MemWr( HIGHTIME, (tv.tv_sec>>16)&0xffff );
  1862.           }
  1863. #endif
  1864.           }
  1865.           break;
  1866. #ifdef CSP_IDS
  1867.         case CSP_IDS:
  1868.           {
  1869.         word    BufPtr    = Pop();
  1870.         word    Arg2Ptr   = Pop();
  1871.         CspIdSearch(BufPtr, Arg2Ptr);
  1872.           }
  1873.           break;
  1874. #endif
  1875. #ifdef CSP_TRS
  1876.         case CSP_TRS:
  1877.           {
  1878.         word TokenBuf  = Pop();
  1879.         word ResultPtr = Pop();
  1880.         word NodePtr   = Pop();    /* initialize with root node addr   */
  1881.         Push(CspTreeSearch(TokenBuf, ResultPtr, NodePtr));
  1882.           }
  1883.           break;
  1884. #endif
  1885.         case CSP_FLC:
  1886.           {
  1887.         word    ch     = Pop();
  1888.         word    Len    = Pop();
  1889.         Integer Offset = PopInteger();
  1890.         word    Addr   = Pop();
  1891.         if (!(Len&0x8000))
  1892.           while (Len--)
  1893.             MemWrByte(Addr, Offset++, ch);
  1894.           }
  1895.           break;
  1896.         case CSP_SCN:
  1897.           {
  1898.         word    Dummy  = Pop();
  1899.         Integer    Offset = PopInteger();
  1900.         word    Buf    = Pop();        /* Buffer Address */
  1901.         word    ch     = Pop();        /* zu suchendes Zeichen */
  1902.         word    match  = Pop();        /* 0 suche nach ==ch,
  1903.                            !=0: Suche nach !=ch */
  1904.         word    limit  = Pop();        /* Limit */
  1905.         word    res;
  1906.         
  1907.         if (limit&0x8000)
  1908.           {
  1909.             limit=0x10000-limit;
  1910.             for (res=0; res<limit; res++)
  1911.               if (MemRdByte(Buf, Offset-res)!=ch)
  1912.             { if (match) break; }
  1913.               else
  1914.             { if (!match) break; }
  1915.             Push(0x10000-res);
  1916.           }
  1917.         else
  1918.           {
  1919.             for (res=0; res<limit; res++)
  1920.               if (MemRdByte(Buf, Offset+res)!=ch)
  1921.             { if (match) break; }
  1922.               else
  1923.             { if (!match) break; }
  1924.             Push(res);
  1925.           }
  1926.           }
  1927.           break;
  1928.         case CSP_USTAT:
  1929.           {
  1930.         word    Dummy  = Pop();
  1931.         Integer Offset = PopInteger();
  1932.         word    Addr   = Pop();
  1933.         word    Unit   = Pop();
  1934.         UnitStat(Unit, Addr, Offset, Dummy);
  1935.           }
  1936.           break;
  1937. #ifdef CSP_LDSEG
  1938.         case CSP_LDSEG:
  1939.           CspLoadSegment(Pop());
  1940.           break;
  1941. #endif
  1942. #ifdef CSP_ULDSEG
  1943.         case CSP_ULDSEG:
  1944.           CspUnloadSegment(Pop());
  1945.           break;
  1946. #endif
  1947.         case CSP_TRC:
  1948.           f=PopReal();
  1949.           if (f<0)
  1950.         Push(ceil(f));
  1951.           else
  1952.         Push(floor(f));
  1953.           break;
  1954.         case CSP_RND:
  1955.           Push(rint(PopReal()));
  1956.           break;
  1957.         case CSP_MRK:
  1958.           ClrGDirP();
  1959.           MemWr(Pop(),Np);
  1960.           break;
  1961.         case CSP_RLS:
  1962.           Np=MemRd(Pop());
  1963.           StackCheck();
  1964.           MemWr(GDIRP, NIL);
  1965.           break;
  1966.         case CSP_IOR:
  1967.           Push(MemRd(IORSLT));
  1968.           break;
  1969.         case CSP_UBUSY:
  1970.           Push(UnitBusy(Pop()));
  1971.           break;
  1972.         case CSP_POT:
  1973.           {
  1974.         float PwrOfTen[]={1e0,  1e1,  1e2,  1e3,  1e4,  1e5,
  1975.                   1e6,  1e7,  1e8,  1e9,  1e10, 1e11,
  1976.                   1e12, 1e13, 1e14, 1e15, 1e16, 1e17,
  1977.                   1e18, 1e19, 1e20, 1e21, 1e22, 1e23,
  1978.                   1e24, 1e25, 1e26, 1e27, 1e28, 1e29,
  1979.                   1e30, 1e31, 1e32, 1e33, 1e34, 1e35,
  1980.                   1e36, 1e37, 1e38, 1e39};
  1981.         int Value=PopInteger();
  1982.         if ( (Value<0) || (Value>39) )
  1983.           PushReal(0);/* WWW: XeqError(XINVNDX); */
  1984.         else
  1985.           PushReal(PwrOfTen[Value]);
  1986.           }
  1987.           break;
  1988.         case CSP_UWAIT:
  1989.           UnitWait(Pop());
  1990.           break;
  1991.         case CSP_UCLEAR:
  1992.           UnitClear(Pop());
  1993.           break;
  1994.         case CSP_HLT:
  1995.           return;
  1996.           break;
  1997.         case CSP_MAV:
  1998.           if (MemRd(GDIRP))
  1999.         w=Kp-MemRd(GDIRP);
  2000.           else
  2001.         w=Kp-Np;
  2002.           Push(w/2);
  2003.           break;
  2004.         default:
  2005.           XeqError(XNOTIMP);
  2006.         }
  2007.       break;
  2008.  
  2009.     case BPT:
  2010.       p1 = FetchB();
  2011.       if ( (MemRd(BUGSTATE)>=3) ||
  2012.            (p1 == MemRd(BRKPTS0)) ||
  2013.            (p1 == MemRd(BRKPTS1)) ||
  2014.            (p1 == MemRd(BRKPTS2)) ||
  2015.            (p1 == MemRd(BRKPTS3)) )
  2016.         XeqError(XBRKPNT);
  2017.       break;
  2018.     case XIT:
  2019.       return;
  2020.       XeqError(XHLTBPT);
  2021.       break;
  2022.     case NOP:
  2023.       break;
  2024.     default:
  2025.       XeqError(XNOTIMP);
  2026.       break;
  2027.     }
  2028.     }
  2029. }
  2030.  
  2031. word LookupFile(word Unit, const char *Name)
  2032. {
  2033.   int i;
  2034.   DiskRead(Unit, Np, 0, 2048, 2);
  2035.   if (MemRd(IORSLT))
  2036.     return(0);
  2037.  
  2038.   for (i=0;i<MemRd(WordIndexed(Np, 8));i++)
  2039.     {
  2040.       word Entry=WordIndexed(Np, 13+13*i);
  2041.       int len;
  2042.       for (len=0; len<MemRdByte(WordIndexed(Entry, 3),0); len++)
  2043.     if (toupper(MemRdByte(WordIndexed(Entry, 3),1+len)) !=
  2044.         toupper(Name[len]))
  2045.       goto next;
  2046.       if (Name[len])
  2047.     continue;
  2048.       return(MemRd(WordIndexed(Entry,0)));
  2049.     next:
  2050.       ;
  2051.     }
  2052.   return(0);
  2053. }
  2054.  
  2055. /* Das Segment 0 ist aufgespalten, und die Zeiger im
  2056.    Procedure-Dictionary sind so korrigiert worden, dass nach dem Laden
  2057.    der beiden Hälften an die jeweils "richtige" Addresse die Zeiger
  2058.    korrekt sind.
  2059.  
  2060.    Diese Routine korrigiert die Zeiger im Segment-Dictionary. Dazu
  2061.    ermittelt sie zuerst die Addresse, an der die zwiete hälfte
  2062.    eigentlich geladen werden sollte. Danach wird ein Offset ermittelt,
  2063.    mit dem die Zeiger in die zweite Hälfte korrigiert werden müssen. */
  2064.  
  2065. static void FixupSeg0(word LoadAddr)
  2066. {
  2067.   word Seg=SegDict[0].Seg;
  2068.   word SegBase=SegDict[0].SegBase;
  2069.   word Addr;
  2070.   word Offset;
  2071.   int i;
  2072.  
  2073.   Addr=0;
  2074.   for (i=1;i<=SegNumProc(Seg); i++)
  2075.     {
  2076.       word JTab=Proc(Seg, i);
  2077.       if (JTab<SegBase)
  2078.     if (JTab>Addr)
  2079.       Addr=JTab;
  2080.     }
  2081.   if (!Addr)
  2082.     return;            /* no Fixup needed */
  2083.   Addr=WordIndexed(Addr,1);
  2084.   Offset=LoadAddr-Addr;
  2085.   if (!Offset)
  2086.     return;
  2087.  
  2088.   for (i=1;i<=SegNumProc(Seg); i++)
  2089.     {
  2090.       word JTab=Proc(Seg, i);
  2091.       if ( (JTab<SegBase) )
  2092.     {
  2093.       Addr=WordIndexed(Seg,-i);
  2094. #ifdef WORD_MEMORY
  2095.       MemWr(Addr, MemRd(Addr)-2*Offset);
  2096. #else
  2097.       MemWr(Addr, MemRd(Addr)-Offset);
  2098. #endif
  2099.     }
  2100.     }
  2101. }
  2102.  
  2103. static void load(word Unit, word BlockNo)
  2104. {
  2105.   int    i;
  2106.  
  2107.   DiskRead(Unit, Np, 0, 512, BlockNo);
  2108.   if (MemRd(IORSLT))
  2109.     return;
  2110.  
  2111.   /* Erzeuge das Segment Dictionary */
  2112.   for (i=0;i<16;i++)
  2113.     {
  2114.       word    CodeAddr=MemRd(WordIndexed(Np, 2*i))+BlockNo;
  2115.       word    CodeLeng=MemRd(WordIndexed(Np, 2*i+1));
  2116.       word    SegInfo =MemRd(WordIndexed(Np, i+0x80));
  2117.  
  2118.       assert (!(CodeLeng&1));
  2119.  
  2120.       if (CodeAddr && CodeLeng)
  2121.     {
  2122.       int    SegNo=SegInfo&0xff;
  2123.       if (SegInfo&0x0f00)
  2124.         {
  2125.           MemWr(SEG_UNIT(SegNo),  Unit);
  2126.           MemWr(SEG_BLOCK(SegNo), CodeAddr);
  2127.           MemWr(SEG_SIZE(SegNo),  CodeLeng);
  2128.         }
  2129.       if (SegNo==0)
  2130.         {
  2131.           if (!SegDict[0].UseCount)
  2132.         {
  2133.           SegDict[0].UseCount++;
  2134.           SegDict[0].OldKp=Kp;
  2135.           SegDict[0].Seg=WordIndexed(Kp,-1);
  2136. #ifdef WORD_MEMORY
  2137.           Kp-=CodeLeng/2;
  2138. #else
  2139.           Kp-=CodeLeng;
  2140. #endif
  2141.           SegDict[0].SegBase=Kp;
  2142.           DiskRead(Unit, Kp, 0, CodeLeng, CodeAddr);
  2143.         }
  2144.           else
  2145.         {
  2146. #ifndef WORD_MEMORY
  2147. #ifdef APPLE_SEG0_LOAD_GAP
  2148.           if (AppleCompatibility)
  2149.             {
  2150.               Kp-=APPLE_SEG0_LOAD_GAP;
  2151.               assert (Syscom>=Kp );
  2152.               assert (WordIndexed(Syscom, SYSCOM_SIZE) <
  2153.                   Kp+APPLE_SEG0_LOAD_GAP );
  2154.             }
  2155. #endif
  2156. #endif
  2157.           FixupSeg0(Kp);
  2158. #ifdef WORD_MEMORY
  2159.           Kp-=CodeLeng/2;
  2160. #else
  2161.           Kp-=CodeLeng;
  2162. #endif
  2163.           DiskRead(Unit, Kp, 0, CodeLeng, CodeAddr);
  2164.         }
  2165.         }
  2166.     }
  2167.     }
  2168. }
  2169.  
  2170. void LoadSystem(int RootUnit, const char *FileName)
  2171. {
  2172.   int    Unit=0;
  2173.   int    Block;
  2174.  
  2175.   if ((Block=LookupFile(RootUnit, FileName)))
  2176.     Unit=RootUnit;
  2177.   else
  2178.     for (Unit=4; Unit<MAX_UNIT; Unit++)
  2179.       {
  2180.     if (Unit==6)
  2181.       Unit=9;
  2182.     if ((Block=LookupFile(Unit, FileName)))
  2183.       break;
  2184.       }
  2185.   if (!Block || !Unit)
  2186.     panic("%s: not found", FileName );
  2187.  
  2188.   load(Unit, Block);
  2189.   if (MemRd(IORSLT))
  2190.     panic("$s unit %d block %d: Ioerror %d",
  2191.       FileName, Unit, Block, MemRd(IORSLT));
  2192.   if (!SegDict[0].UseCount)
  2193.     panic("%s: not a valid system, no segment 0", FileName );
  2194.  
  2195.   call(SegDict[0].Seg, 1, NIL);
  2196. }
  2197.  
  2198. int main (int argc, char *argv[])
  2199. {
  2200.   int        i;
  2201.   int        Unit=4;
  2202.   int        UseXTerm=0;
  2203.   int        BatchFd=-1;
  2204.   const char    *SystemName="system.pascal";
  2205.  
  2206.   memset(SegDict, 0, sizeof(SegDict));
  2207.   MemInit();
  2208.   DiskInit();
  2209.   TraceProc=0;
  2210.   TraceSeg=1;
  2211.  
  2212.   while ((i=getopt(argc, argv, 
  2213. #ifndef WORD_MEMORY
  2214.            "a"
  2215. #endif
  2216.            "b:gn:t:T:w:r:f:xV"))!=EOF)
  2217.     switch(i)
  2218.       {
  2219. #ifndef WORD_MEMORY
  2220.       case 'a':
  2221.     AppleCompatibility=1;
  2222.     break;
  2223. #endif
  2224.       case 'b':
  2225.     if (!optarg || !*optarg)
  2226.       {
  2227.         fprintf(stderr,"-b option requires filename argument or '-' for stdin\n");
  2228.         exit(1);
  2229.       }
  2230.     if (strcmp(optarg, "-")==0)
  2231.       BatchFd=0;
  2232.     else
  2233.       if ((BatchFd=open(optarg, O_RDONLY))<0)
  2234.         {
  2235.           perror(optarg);
  2236.           exit(1);
  2237.         }
  2238.     break;
  2239.  
  2240.       case 'g':
  2241.     TraceLevel=0x7fff;
  2242.     break;
  2243.       case 'n':
  2244.     if (!optarg || !*optarg)
  2245.       {
  2246.         fprintf(stderr,"-n option requires filename argument or '-' for stdout\n");
  2247.         exit(1);
  2248.       }
  2249.     SystemName=optarg;
  2250.     break;
  2251.       case 't':
  2252.     if (!optarg || !*optarg)
  2253.       {
  2254.         fprintf(stderr,"-t option requires filename argument\n");
  2255.         exit(1);
  2256.       }
  2257.     if (strcmp(optarg,"-")==0)
  2258.       TraceFile=fdopen(dup(1), "w");
  2259.     else 
  2260.       {
  2261.         if (!(TraceFile=fopen(optarg,"w")))
  2262.           {
  2263.         perror(optarg);
  2264.         exit(1);
  2265.           }
  2266.       }
  2267.     break;
  2268.       case 'T':
  2269.     SetTrace(optarg);
  2270.     break;
  2271.  
  2272.       case 'w':
  2273.       case 'r':
  2274.       case 'f':
  2275.     {
  2276.       enum DiskMode Mode;
  2277.       switch(i)
  2278.         {
  2279.         case 'w':    Mode=ReadWrite;    break;
  2280.         case 'r':    Mode=ReadOnly;    break;
  2281.         case 'f':    Mode=Forget;    break;
  2282.         }
  2283.       if (!optarg || !*optarg)
  2284.         {
  2285.           fprintf(stderr,"-%c option requires filename argument\n", i);
  2286.           exit(1);
  2287.         }
  2288.       if (DiskMount(Unit, optarg, Mode)<0)
  2289.         exit(1);
  2290.       Unit++;
  2291.       if (Unit==6) Unit=9;
  2292.     }
  2293.     break;
  2294.       case 'x':
  2295.     UseXTerm++;
  2296.     break;
  2297.       case 'V':
  2298.     fprintf(stderr, "%s, a UCSD p-code interperter version %s\n", argv[0], VERSION);
  2299.     fprintf(stderr, "For updated versions check http://www.klebsch.de/.\n");
  2300.     exit(0);
  2301.     break;
  2302.       }
  2303.  
  2304.   TermOpen(UseXTerm, BatchFd);
  2305.     
  2306. #ifndef WORD_MEMORY
  2307.   if (AppleCompatibility)
  2308.     {
  2309.       Np=APPLE_HEAP_BOT;
  2310.       Kp=APPLE_KP_TOP;
  2311.       Syscom=APPLE_SYSCOM;
  2312.     }
  2313.   else
  2314. #endif
  2315.     {
  2316.       Np=HEAP_BOT;
  2317.       Kp=KP_TOP;
  2318.       Kp=WordIndexed(Kp, -SYSCOM_SIZE);
  2319.       Syscom=Kp;
  2320.     }
  2321.   Sp=SP_TOP;
  2322.   Mp=Kp;
  2323.  
  2324.   LoadSystem(4, SystemName);
  2325.   BaseMp=Mp;
  2326.   Sp=WordIndexed(Sp,1);            /* SP korrigieren */
  2327.  
  2328.   MemWr( LocalAddr(1), Syscom );
  2329.   MemWr( GDIRP  , NIL );
  2330.   MemWr( SYSUNIT, 4 );
  2331.  
  2332. #ifndef WORD_MEMORY
  2333.   if (AppleCompatibility)
  2334.     {
  2335.       MemWr( WordIndexed(Syscom,161), 0x4bd);
  2336.       MemWr( WordIndexed(Syscom,166), 0x6);
  2337.       MemWrByte( WordIndexed(Syscom,169), 1, 0x81);/* Bitfeld mit
  2338.     }                              unbekanntem Inhalt */
  2339. #endif
  2340.  
  2341.   Processor();
  2342.  
  2343.   DumpCore();
  2344.   if (TraceFile)
  2345.     fclose(TraceFile);
  2346.  
  2347.   while (Unit>4)
  2348.     {
  2349.       Unit--;
  2350.       if (Unit==8)
  2351.     Unit=5;
  2352.       DiskUmount(Unit);
  2353.     }
  2354.   TermClose();
  2355.   return(0);
  2356. }
  2357.